perm filename MOVX.1[NEW,LCS] blob sn#145110 filedate 1975-02-13 generic text, type T, neo UTF8
C******  MOVER, MVBEAM, MVBX, RTLINE, EXTEN, CLEFS
	SUBROUTINE MOVER
	IMPLICIT INTEGER(A-Q,S-Z)
	DIMENSION R(2,200),IR(2,200)
	REAL PWDS,POS,EXTEN
	COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/STF/RSTFAC(-3/4),RSTJ2
	COMMON/XRN/RN(4000)  /KJY/ K,JY
	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
	COMMON/POSI/STFF(-3/4),JJ2,POS/PTR/PWDS(250),ITEM,LL,I,IX
	COMMON/ALF/INP(47),ML,RRT,RZRO,RCNT,RJSZ,ROV,RSPC,KN,RA,RB,
	1 JLDGR,LDGR,JX,RW,RX,RY,RZ,JJ,RD,RQ,RE,RZZ,RN3,RN6,RV,RQ6
      EQUIVALENCE (R5,RJQ(3)),(R6,RJQ(4)),(R7,RJQ(5)),(R4,RJQ(2))
	1,(R3,RJQ(1)),(R8,RJQ(6)),(R9,RJQ(7)),(R11,RJQ(9))
	1,(IR,R,RN(3101))
	DATA F78F/'(78F)'/,FA1/'(A1 )'/,FA5/'(A5 )'/,RSP/.5/,RI/4.5/

	JJ2=-1
	J2=0
C  99=BACKUP
6	CALL VLINE(R2,R4,R5,R6)
	IF(R2.GE.99)RETURN
	IF(INP(1).NE.'J')GO TO 12
	RRT=R5
	RZRO=R4
	IF(RRT.EQ.0)RRT=200
	IF(RZRO.EQ.0)RZRO=.001
	RCNT=0
	RJSZ=RI
	ASK=-1
	R7=R2
	R6=0
	R11=0
19	IF(RCNT.GT.9)GO TO 101
	ROV=RRT
	RJSZ=RJSZ-.1
	RCNT=RCNT+1
C  TEMPORARY COUNTER
	ML=1
	TYPE F78F,RCNT

	DO 11 KN=-3,4
	RSPC=0
	R8=KN
	N=0

	DO 2 K=1,ITEM
	L=PWDS(K)
	IF(RTLINE(L))GO TO 2
	RA=RN(L+1)
	RB=RN(L+3)
	IF((RN(L+2).NE.R8.AND.RA.NE.4).OR.RB.LT.RZRO)GO TO 2
C  SKIPS HOMED NOTES (IN CHORDS)
	IF(RA.EQ.1)GO TO 10
27	IF(RA.GT.4.AND.RA.LT.17)GO TO 2
C  LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.
	IF(RA.EQ.4.AND.RN(L).GT.2)GO TO 2
C  SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
10	N=N+1
	R(1,N)=RB
	IR(2,N)=L
	IF(N.EQ.200)GO TO 28
C  ONLY TREATS 200 ITEMS AT A TIME.
2	CONTINUE

	IF(N.EQ.0)GO TO 11
28	DO 23 K=1,N
23	IF(RN(IR(2,K)+1).NE.4)GO TO 24
C  SKIPS IF ONLY BAR LINES ON THIS STAFF
	GO TO 11
24	RSTJ2=RSTFAC(KN)
	CALL SORT2(R,N)

C  JUMP IF LAST IS A BAR LINE.
	K=0
	JLDGR=0
     	JX=0
22	K=K+1
122	L=IR(2,K)
	RA=RN(L+1)
	RB=0
	RX=RN(L+5)
C  RX=PARAM 5
	RX6=RN(L+6)
	RY=1
	RW=AMOD(RN(L+4),100.)
	IF(RA.GT.1)GO TO 4
	RZ=RN(L+7)
	IF(LDGR.NE.JLDGR)JLDGR=0
	LDGR=0
	JY=K
	DO 32 JJ=JY+1,N+1
	K=JJ
32	IF(R(1,JJ)-R(1,JJ-1).GT.RSP)GO TO 35
C  FOUND HOW MANY MEMBERS TO CHORD.
35	RB=0
	K=K-1
	RQ=0
	RD=0
125	IF(AMOD(RN(L+4),200.).GT.60.)RY=.6
	DO 37 JJ=JY,K-1
	IF(RD.NE.0)GO TO 38
C FINDS ONLY HIGH OR! LOW LED. LINE.
	JR=IR(2,JJ)
	RW=AMOD(RN(JR+4),100.)
	IF(RW.LE.11.AND.RW.GE.2)GO TO 38
	LDGR=-1
	IF(RW.GT.11)LDGR=1
	IF(JLDGR.EQ.LDGR)GO TO 36
	JLDGR=LDGR
C LDGR IS FOR LEDGER LINES.
	GO TO 38
36	RD=1.5
	RQ=RD
38	IF(RB.GT.2)GO TO 222
C  JUMP IF LARGE SPACE AFTER NOTE IS ALREADY SET UP.
	RZZ=RN(JR+7)
	RE=RN(JR+5)
	IF(RB.LT.2.AND.((AMOD(RZZ,10.).NE.0.AND.RE.LT.20).
	1 OR.RZZ.GE.10))RB=1.5+EXTEN(RZZ)
C  SPACE FOR DOT OR TAIL(IF STEM UP)
	IF(ABS(RN(JR+6)).EQ.10)RB=RB+2
C  FOR CHORD TONES ON RIGHT OF STEM UP.
C  LOOKS THROUGH ALL NOTES OF A CHORD.
222	IF(AMOD(RE,10.).EQ.0)GO TO 37 
C  JUMP IF NO ACCIS.
425	RD=2*RY+EXTEN(RE)
	IF(RQ.GT.RD)RD=RQ
	RQ=RD
C  FUNCT. EXTEN=AMOD(X,1.)*10.
37 	CONTINUE
	IF(RY.NE.1)RB=RB-.5*RJSZ
C  MINI NOTES NEED LESS SPACE
25	IF(JX.GT.0)R(2,JX)=R(2,JX)+RD*RSTJ2
	GO TO 17
4	IF(RA.NE.3)GO TO 29
	RB=3
	IF(RX.GT.100)RB=1.5
C  CHECK ON SIZE NEEDED FOR CLEFS
29	IF(RA.NE.4)GO TO 26
	RB=-RJSZ/2
	RD=.9
	GO TO 25
26	IF(RA.NE.18)GO TO 30
	IF(RX6.GT.9.OR.RX.GT.9)GO TO 31
C  CHECKS FOR 2-DIGIT METERS
	RB=-1
	RD=1
	GO TO 25
31	RB=2
	RD=3
	GO TO 25
30	IF(RA.NE.17)GO TO 17
	RB=2*(ABS(RX)-1)-2
C  SPACES FOR CORRECT NUM OF ACCIS.  RX=NUM OF ACCIS.
	RD=2
	GO TO 25
17	RC=(RB+RJSZ)*RSTJ2
C  RJSZ=DEFAULT SIZE
	JX=JX+1
	R(2,JX)=RC
	R(1,JX)=R(1,K)
3	IF(K.LT.N)GO TO 22
	RA=R(1,1)
	RB=R(2,1)

	DO 13 KX=2,JX
	RE=R(1,KX)
C  POS. BEFORE SHIFTING
	IF(ABS(RE-RA).GT..5)GO TO 14
	IF(R(2,KX).GT.RB)GO TO 16
C  SKIPS DOUBLE STOPS AND VERY CLOSE ITEMS
	GO TO 13
C  JUMP WHEN SPACE TO ADD IS SMALLER THAN WHAT'S ALREADY THERE
14	RD=RA+RB-RE
	IF(RD.LE.0)GO TO 16
C  THERE'S ENOUGH ROOM
	R4=RE+RSPC-.001
	R5=1000
	R8=RD
	R9=0
	RSPC=RSPC+RD
C  RSPC SAVES TOTAL SPACE ADDED
C  GO EXPAND IT
	IF(R(2,KX).NE.0)GO TO 166
16	RB=R(2,KX)
13	RA=RE
11	CONTINUE
110	IF(ROV.LE.RRT+.01)GO TO 18
	R4=RZRO
	R5=ROV
	R8=RZRO
	R9=RRT-.001
C  JUSTIFYING SPACE DIMINISHES EACH TIME AROUND.
	ML=3
	IF(RJSZ.GT.4)RJSZ=4
	GO TO 66
18	ML=4
	R8=ROV
	R9=RRT+2
C  GOES BACK TO PICK UP DANGLING ITEMS(BEYOND RRT)
	R4=ROV
	R5=500
166	JJ2=-1
	J2=0
	GO TO 66
1200	FORMAT(' MOVED TO STAFF ',F4.0/)
C******  BEGIN MOVER *******
12	TYPE 5
	ML=2
	ACCEPT F78F,R7,R8,R9,R11
	RDIS=0
	REREAD FA1,L
C FOR LPEN TYPE 'L'. BUT 4TH # MUST APPEAR WHEN NEEDED.
	IF(R2.NE.88)GO TO 167
C  88, 1ST ITEM, LAST ITEM:   STAFF N, MOVE HOR., MOVE VERT.
	LDGR=R5
	J2=R4-1
C  1ST ITEM.
	R4=-500
	R5=500
	L=I
C  ↑↑↑↑ FOR 'C'OPY
168	IF(J2.GT.LDGR)GO TO 101
	JY=PWDS(J2+1)
	IF(INP(1).NE.'C')L=JY
	GO TO 6551

167	IF(R7.GE.99)GO TO 6
	IF(R7.NE.R2)TYPE 1200,R7
	IF(R2.GT.4)R7=R2
	IF(L.NE.'L')GO TO 66
	DO 67 K=1,2
	R8=RY
	CALL LPEN(R7,RY,RX)
67	IF(R7.GE.99)GO TO 6
	R9=RY

66	JY=1
	L=JY
	IF(INP(1).EQ.'C')L=I
C  C=COPY
	IF(R9.NE.0)RDIS=(R9-R8)/(R5-R4)

6551	RB=RN(JY)
	J2=J2+1
	IF(RTLINE(JY))GO TO 7551
C  IF STAFF#>4, ALL STAVES ARE MOVED.
	RA=RN(JY+1)
	IF(R6.GT.0.AND.R6.NE.RA)GO TO 7551
C SKIPS IF NOT SPECIAL CODE NUM.
	RN3=RN(JY+3)
	IF(RN3.GT.R5)GO TO 7551
	RC=-1
	RD=0
	IF(RA.GE.5.AND.RA.LE.7)RD=-1
	IF(RA.EQ.4..OR.RD.OR.RN(JY+5).EQ.50)RC=0
C RC=0 FOR CODES 4,5,6
	RN6=RN(JY+6)
	IF(RN3.GE.R4)GO TO 8
      IF(RC.OR.(RC.EQ.0.AND.(RN6.LE.R4.OR.RN6.GE.R5)))GO TO 7551
C RIGHT SIDE IS BEFORE OR AFTER MOVE AREA.
C  IF INP(1)='C' MOVE TO NEW SPOT AND LEAVE OLD BEHIND.
8	IF(ASK)GO TO 100
	CALL ASKIT
	IF(K.EQ.'N')GO TO 7551
	IF(K.EQ.'X')GO TO 1
C  'X'=EXIT
C  N=NO, <CR>=YES
100	IF(INP(1).NE.'C')GO TO 9551
	K=RB+2
	CALL LOOP(0,K,1,L,JY,RN)
	ITEM=ITEM+1
	IF(JJ2)JJ2=ITEM
C  JJ2 SAVES ITEM # FOR MAIN PROG.
	PWDS(ITEM+1)=L+K+1
9551	IF(JJ2)JJ2=J2
C   (50=CRESC., DECRESC.)
	IF(R2.LT.5.OR.R2.EQ.88.)RN(L+2)=R7
	IF(RA.EQ.8)GO TO 7552
C 8=STAFF. ONLY MOVES OR COPIES TO NEW STAFF NUM. OTHER PARAMS UNAFFECTED.
	RQ6=RN6-R5
	RX=0
	RV=0
	IF(RA.NE.6.OR.RB.LT.7)GO TO 21
	RX=RN(L+9)
	RY=RX-R5
	RZ=R4-RX
	IF(RN(L+10).LT.30)GO TO 221
	RW=RN(L+8)
	IF(RW.GE.R4.AND.RW.LE.R5)RV=-1
221	IF(RY.AND.RZ)RX=-1
C PARTIAL BEAM IS WITHIN MOVE AREA.
21	IF(R9.EQ.0)GO TO 2551
	IF(RN3.GE.R4)CALL MVBX(3)
C  MOVES P4 LFT-RT.   ↑↑↑↑↑↑↑↑
	IF(RC)GO TO 7552
	IF(RA.EQ.4..AND.RB.LT.4)GO TO 7552
	IF(RQ6)CALL MVBX(6)
C  END POINT OUTSIDE OF MOVE RANGE NOT AFFECTED.
	IF(RA.NE.6)GO TO 7552
	IF(RX)CALL MVBX(9)
	IF(RV)CALL MVBX(8)
C  ONLY TRUE WHEN RA=6
	GO TO 7552

2551	IF(RN3.GE.R4)RN3=RN3+R8
	RN(L+3)=RN3
      IF(RQ6.AND.(RD.OR.(RA.EQ.4.AND.RB.GT.3.)))RN(L+6)=RN(JY+6)+R8
	IF(RX)CALL MVBEAM(RN,9,JY,L,R8)
	IF(RV)CALL MVBEAM(RN,8,JY,L,R8)
	IF(RN3.GT.ROV)ROV=RN3
C ??? NOT YET FIXED FOR ENDS OF SLURS OR LINES
7552	L=RB+3+L
	IF(R11.EQ.0)GO TO 7551
1551	IF((RB.LT.3..AND.RA.NE.13.AND.RA.NE.11).OR.RA.EQ.18.OR.
	1 RA.EQ.7)GO TO 7551
C  'U-D' SKIPS METER, STAFF, KEY SIG., ETC.
	JX=JY
	IF(INP(1).EQ.'C')JX=PWDS(ITEM)
	CALL MVBEAM(RN,4,JX,JX,R11)
	IF(RC.EQ.0)CALL MVBEAM(RN,5,JX,JX,R11)
7551	JY=RB+3+JY
	IF(INP(1).NE.'C')L=JY
	IF(R2.EQ.88)GO TO 168
	IF(JY.LT.I)GO TO 6551
	GO TO (16,1,19,101),ML
101	JJ2=1
1	CALL HYDPOG(3)
5	FORMAT(' TYPE NEW STAFF #, POS1, POS2, UP-DOWN #  '$)
	END

	FUNCTION RTLINE(L)
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
	RTLINE=-1
	IF(R2.GT.4.OR.RN(L+2).EQ.R2)RTLINE=0
	END

	FUNCTION EXTEN(X)
	EXTEN=AMOD(X,1.)*10.
	END

C  THESE MOVE ENDS OF PARTIAL INNER BEAMS.
	SUBROUTINE MVBEAM(R,I,JY,L,W)
C  L AND JY ARE FOR MOVES TO DIFF. STAFF.
	DIMENSION R(1)
	Y=R(JY+I)
	Z=ABS(Y)
	IF(Z.LT.100.)GO TO 1
C  NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
	Y=AMOD(Y,100.)
	X=Y+W
	Z=Z-ABS(Y)+ABS(X)
C  PUTS ALL INTO POSITIVE
	IF(X)Z=-Z
	GO TO 2
1	Z=Y+W
2	R(L+I)=Z
	END

	SUBROUTINE MVBX(I)
      COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS,JQ(18)/KJY/K,JY/XRN/R(4000)
	EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
	R(L+I)=R8+(R(JY+I)-R4)*RDIS
	END

	SUBROUTINE CLEFS
      DIMENSION JCLEF(11),MCLEF(700),RCMIN(4),KCLEF(11),NCLEF(350),CM(4)
	COMMON /STF/RSTFAC(8),RSTJ2 /PLTR/IPLT,RHT,DIS
	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
      DATA RCMIN/3.3,10.5,7.0,10.5/,CM/.1,1.5,1.1,1.5/
	EQUIVALENCE (R4,RJQ(2)),(J5,JQ(3)),(J9,JQ(7)),(KK,
     1 KCLEF(11)),(R6,RJQ(4)),(R5,RJQ(3)),(R8,RJQ(6)),(R7,RJQ(5))
	1,(R9,RJQ(7)),(NJR,RJQ(8)),(K,JCLEF(11)),(NCLEF,MCLEF(351))
	1,(R3,RJQ(1))
	J5=MOD(J5,100)
	CALL NOZERO(R6)
	IF(R7.EQ.0)R7=R6
C  IF P7 = 0, IT WILL EQUAL P6.
	IF(JA.GT.10)GO TO 9
	NAME='CLEF0'
	IF(J5.LT.20)GO TO 4
	R6=R6*.3
C  SIZE FACTORS FOR SPECIAL WORDS, ETC. (PPP, MF, CRESC. ETC.)
	R7=R7*.3
	GO TO 4
9	IF(NAME.EQ.NJR)GO TO 4
	IF(NAME.NE.0.AND.NJR.EQ.0)GO TO 4
	IF(NJR.EQ.0)GO TO 8	
C  TO PICK UP BASIC DRAW NAME FROM P10 
	NAME=NJR
	GO TO 4
8	TYPE 5
5	FORMAT(' SET P10=1'/)
C  LEADS TO PROPER FILE CALL
4	NM=NAME+2*(J5/10)
C  DRAW0 HAS ITEMS 0→9;  DRAW1, 10→19; ETC. TO DRAW9, 90→99
	JEZ=MOD(J5,10)+1
2	IF(NM.EQ.JNM.OR.NM.EQ.KNM)GO TO 30
C  SET P10≠0 TO CHANGE BASIC 'DRAW' NAME.
C  JUMP IF ALREADY IN CORE
	IF(LOOKF(NM))GO TO 1111
	TYPE 1112,NM
	RETURN
1112	FORMAT(1XA5,' -- NOT FOUND')
1111	CALL GETFI2(NM)
	IF(KX)GO TO 33
	KX=-1
	JNM=NM
	CALL FASTI2(JCLEF,11)
	CALL FASTI2(MCLEF,K)
C  NEW DATA READER  6/74 -- 10/74 HOLDS 2 .DMD FILES IF THEY FIT.
	IF(K.LE.350)GO TO 30
	KX=0
	KNM=0
	GO TO 30
33	CALL FASTI2(KCLEF,11)
	KX=0
	IF(KK.GT.350)GO TO 1111
C  JUMP BACK IF IT WON'T FIT.
	CALL FASTI2(NCLEF,KK)
	KNM=NM
C   CHECK THE ABOVE  -- FOR P5 HEIGHT CHANGE *********************
C  R6 IS SIZE FACTOR
30	IF(J5.GT.3.OR.JA.NE.3)GO TO 811
C  0=TREB, 1=BASS, 2=ALTO, 3=TENOR(ALTO SHIFTED UP)
C  ↑↑↑↑↑↑↑↑  FIXUP SOMEDAY IN .DMD FILES
	IF(R5.LT.100)GO TO 812
	RSTJ2=.8*RSTJ2
C  TO SET HGT. OF MINI CLEFS
	R4=R4+CM(JEZ)
C  SHIFTS MINIS UP BECAUSE OF WRONG ORIG. POS.??
812	IF(JEZ.NE.4)GO TO 811
	R4=R4+2
	JEZ=3
C   ABOVE IS NOW AT TOP

811	A=R4
	R4=A+2.9
	CALL CENTX
	R4=A

	L=JCLEF(JEZ)
	IF(NM.EQ.KNM)L=KCLEF(JEZ)+350
	IF(J9.EQ.0)GO TO 31
	CALL ROTATE(MCLEF,L)
C  R9=P9=DEGREES OF ROTATION (0-360)
	IF(KK.GT.250)KX=0
C CHECK TO SEE IF DATA WAS WIPED OUT.
31	IF(R8.EQ.-2.OR.(R8.NE.-1.AND.IPLT.GE.0))GO TO 32
C			R8=-2 OMITS FILLER DURING PLOT
	DO 3 K=L+1,MCLEF(L)+L
	IF(MCLEF(K).LT.200000000)GO TO 3
	JEZ=MCLEF(L)-1
	IF(K.GT.L+1)JEZ=JEZ-K+L+1
	CALL FILLMS(JEZ,MCLEF(K),R3,CENTR,R6,R7)
	GO TO 32
3	CONTINUE
C  FILLS ONLY WHEN PLOTING OR R8=-1
32	CALL JDRAW(MCLEF(L),R3,CENTR,RSTJ2,R6,R7)
C   3,POS.,STF,NT# OR CLEF,ITEM#,SIZEX,SIZEY, R8=-1 TO FILL ON CRT

	END